home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 27 / CU Amiga Magazine's Super CD-ROM 27 (1998)(EMAP Images)(GB)[!][issue 1998-10].iso / CUCD / Programming / JForth / JTools / IFF / pic_effects < prev    next >
Encoding:
Text File  |  1991-11-14  |  3.0 KB  |  142 lines

  1. \ Provide special effects for pictures.
  2. \ Effects currently supported are:
  3. \
  4. \  Wipes - slowly copy a picture in.
  5. \  Fades - fade to black or vice versa.
  6. \  Rotate - rotate planes for color flashing.
  7. \
  8. \ Author: Phil Burk
  9. \ Copyright: Phil Burk 1988
  10. \
  11. \ 00001 11/13/91 Make PIC.DRAW.WIPE use ClipBlit(), not CLIP.BLIT.RASTPORT
  12.  
  13. decimal
  14. include? pic.blit jiff:pictures
  15.  
  16. ANEW TASK-PIC_EFFECTS
  17.  
  18. 0 constant WIPE_LEFT
  19. 1 constant WIPE_RIGHT
  20. 2 constant WIPE_UP
  21. 3 constant WIPE_DOWN
  22.  
  23. : PIC.SETUP.WIPE { xd yd nlines direction pict -- }
  24.     pict pic.check
  25.     xd pict ..! pic_dst_x
  26.     yd pict ..! pic_dst_y
  27.     direction pict ..! pic_direction
  28. \ Set defaults for wipe_right
  29.     0 pict ..! pic_wipe_xoff
  30.     0 pict ..! pic_wipe_yoff
  31.     direction 2 AND 0= ( left or right )
  32.     IF  nlines pict ..! pic_wipe_w
  33.         pict ..@ pic_src_h pict ..! pic_wipe_h
  34.         pict ..@ pic_src_w nlines / pict ..! pic_count
  35.         direction wipe_left =
  36.         IF  pict ..@ pic_src_w nlines - pict ..! pic_wipe_xoff
  37.         THEN
  38.     \ Set defaults for up and down
  39.     ELSE pict ..@ pic_src_w   pict ..! pic_wipe_w
  40.         nlines pict ..! pic_wipe_h
  41.         pict ..@ pic_src_h nlines / pict ..! pic_count
  42.         direction wipe_up =
  43.         IF  pict ..@ pic_src_h nlines - pict ..! pic_wipe_yoff
  44.         THEN
  45.     THEN
  46. ;
  47.  
  48.  
  49. : PIC.DRAW.WIPE ( picture -- , draw current wipe )
  50.     dup>r ..@ pic_rastport
  51.     r@ ..@ pic_wipe_xoff
  52.     r@ ..@ pic_src_x + ( srcx )
  53.     r@ ..@ pic_wipe_yoff
  54.     r@ ..@ pic_src_y + ( srcy )
  55. \
  56.     gr-currport @ >rel
  57. \
  58.     r@ ..@ pic_wipe_xoff
  59.     r@ ..@ pic_dst_xoff +
  60.     r@ ..@ pic_dst_x + ( dstx )
  61.     r@ ..@ pic_wipe_yoff
  62.     r@ ..@ pic_dst_yoff +
  63.     r@ ..@ pic_dst_y + ( dsty )
  64. \
  65.     r@ ..@ pic_wipe_w  ( srcw )
  66.     r@ ..@ pic_wipe_h  ( srch )
  67.     pic-cur-minterm @
  68.     ClipBlit()
  69.     rdrop
  70. ;
  71.  
  72. : PIC.ADVANCE.WIPE ( picture -- ,  adjust wipe parameters)
  73.     dup>r ..@ pic_direction
  74.     CASE
  75.         wipe_right
  76.         OF  r@ ..@ pic_wipe_xoff   r@ ..@ pic_wipe_w +
  77.             r@ ..! pic_wipe_xoff
  78.         ENDOF
  79.         wipe_left
  80.         OF  r@ ..@ pic_wipe_xoff   r@ ..@ pic_wipe_w -
  81.             r@ ..! pic_wipe_xoff
  82.         ENDOF
  83.         wipe_up
  84.         OF  r@ ..@ pic_wipe_yoff   r@ ..@ pic_wipe_h -
  85.             r@ ..! pic_wipe_yoff
  86.         ENDOF
  87.         wipe_down
  88.         OF  r@ ..@ pic_wipe_yoff   r@ ..@ pic_wipe_h +
  89.             r@ ..! pic_wipe_yoff
  90.         ENDOF
  91.     ENDCASE
  92.     rdrop
  93. ;
  94.  
  95. : PIC.NEXT.WIPE ( picture -- done? )
  96.     dup>r  pic.check
  97.     r@ ..@ pic_count 0>
  98.     IF  r@ pic.draw.wipe
  99.         r@ pic.advance.wipe
  100.     THEN
  101.     r@ ..@ pic_count 1- dup r@ ..! pic_count  1 <
  102.     rdrop
  103. ;
  104.  
  105. : PIC.WIPE ( xd yd nlines direction pict -- , wipe a picture )
  106.     dup>r pic.setup.wipe
  107.     BEGIN r@ pic.next.wipe
  108.         WaitTOF()
  109.     UNTIL
  110.     rdrop
  111. ;
  112.  
  113. \ Fade a picture by scaling its RGB color table.
  114. : PIC.BRIGHTNESS { level pict -- , scale colormaps }
  115.     pict pic.check
  116.     pict ..@ pic_ctable
  117.     siff-ctable pict ..@ pic_num_colors
  118.     level scale.ctable
  119.     siff-ctable pict ..@ pic_num_colors siff.use.ctable
  120. ;
  121.  
  122. : PIC.FADEIN ( rate picture -- )
  123.     max_rgb_scalar 1+ 0
  124.     DO  over wait.frames
  125.         i over pic.brightness
  126.     LOOP 2drop
  127. ;
  128.  
  129. : PIC.FADEOUT ( rate picture -- )
  130.     max_rgb_scalar 1+ 0
  131.     DO  over wait.frames
  132.         max_rgb_scalar i - over pic.brightness
  133.     LOOP 2drop
  134. ;
  135.  
  136. : PIC.ROTATE ( -- , rotate siff-screen )
  137.     siff-screen @ ?dup
  138.     IF dup .. sc_bitmap rotate.planes
  139.         remake.screen
  140.     THEN
  141. ;
  142.